home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / labels.tcl.z / labels.tcl
Text File  |  2002-07-08  |  2KB  |  71 lines

  1. # labels.tcl
  2. #
  3. # Labels used for various things:
  4. #    Main - the exmh version, or the name of a subfolder
  5. #    Folder - the name of the current folder
  6. #    Message - the id of the current message
  7. #
  8. # Copyright (c) 1993 Xerox Corporation.
  9. # Use and copying of this software and preparation of derivative works based
  10. # upon this software are permitted. Any distribution of this software or
  11. # derivative works must comply with all applicable United States export
  12. # control laws. This software is made available AS IS, and Xerox Corporation
  13. # makes no warranty about the software, its performance or its conformity to
  14. # any specification.
  15.  
  16. # Main label line - for version number or subfolder name
  17. proc Label_MainSetup { frame } {
  18.     global label
  19.     set label(main) [Widget_Label $frame label {left fill expand}]
  20. }
  21. proc Label_Main { {text {} } } {
  22.     global exmh label
  23.     if {$text == {}} {
  24.     $label(main) configure -text $exmh(version)
  25.     } else {
  26.     $label(main) configure -text $text
  27.     }
  28. }
  29.  
  30. # Folder label for folder name
  31. proc Label_FolderSetup { frame } {
  32.     global label
  33.     set label(folder) [Widget_Label $frame label {left fill expand}]
  34.     catch {$label(folder) configure -width 35}
  35. }
  36. proc Label_Folder { folder {text {}} } {
  37.     global label
  38.     if {[string length $text] == 0} {
  39.     set text [Folder_Summary $folder]
  40.     }
  41.     if [regsub {has[     ]*no *messages} $text {is empty} newtext] {
  42.     set text $newtext
  43.     } else {
  44.     set len [string length $text]
  45.     if {$len > 35} {
  46.         set i [expr $len-35]
  47.         set text "[string range $text $i end]"
  48.     }
  49.     }
  50.     $label(folder) configure -text $text
  51. }
  52. proc Label_FolderClear { folder } {
  53.     global label
  54.     $label(folder) configure -text $folder+
  55. }
  56. # Message label for message id
  57. proc Label_MessageSetup { frame } {
  58.     global label
  59.     set label(message) [Widget_Label $frame label {left fill}]
  60.     $label(message) configure -width 20 -anchor w
  61. }
  62. proc Label_Message { text } {
  63.     global label
  64.     set len [string length $text]
  65.     if {$len > 20} {
  66.     set i [expr $len-17]
  67.     set text "...[string range $text $i end]"
  68.     }
  69.     $label(message) configure -text $text
  70. }
  71.